1 Introducción

Este documento consiste en una revisión del proceso de validación de EPSOC 2018. Se trata de un documento reproducible y dinámico que será actualizado cada vez que haya una nueva entrega de datos durante el trabajo de campo. El código está inserto dentro del documento, pero replegado. Para verlo hacer click en cuadro code.

2 Preámbulo

Se cargan los datos en el formato entregado y se homogeneiza el formato en minúscula y usando puntos (“.”) para separar en vez de guiones bajos (“_”).

pacman::p_load(tidyverse, lubridate, anytime, chron,
               haven, sf,
               sjlabelled, sjmisc, 
               validate, eeptools, kableExtra, janitor, here, naniar,
               captioner)

if(Sys.info()[["user"]] == 'caayala'){
  path <- "/Users/caayala/Dropbox (DESUC)/DESUC/Proyectos/3 Políticas Públicas/EPSOC 2018/BD/"
} else if(Sys.info()[["user"]] == 'Andres') {
  path <- "/Users/Andres/Dropbox (DESUC)/Proyectos/3 Políticas Públicas/EPSOC 2018/BD/"
}

epsoc <-haven::read_spss(paste0(path, '190205 - EPSOC Base parcial 16.sav')) %>% 
  clean_names() %>% 
  mutate(region = folio %/% 100000,
         i_1_orden = as.integer(i_1_orden))

names(epsoc) <- tolower(gsub("_", ".", names(epsoc)))

grabacion <- FALSE
kable_estilo <- function(tabla){
  tabla %>% 
    kableExtra::kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                              full_width=F)
}
makeVlist <- function(dta) { 
        labels <- sapply(dta, function(x) attr(x, "label"))
        tibble(name = names(labels),
               label = labels)
        
}  ## Etiquetas variables
labs.epsoc <- makeVlist(epsoc)
labs.epsoc <- labs.epsoc %>% 
  mutate(label2 = map_chr(label, toString))

labs.epsoc <- get_label(epsoc)

3 General

La actual base cuenta con 818 casos recogidos entre el 2018-10-17 y el 2019-02-03.

epsoc %>% 
  count(region, status) %>% 
  spread(status, n) %>% 
  janitor::adorn_totals(where = c('row', 'col')) %>% 
  kable() %>% 
  kable_estilo()
region Aceptado In Progress (Other) Requires Approval Total
2 294 28 25 347
9 95 11 57 163
13 205 49 54 308
Total 594 88 136 818

3.1 Distribución encuestado

epsoc <- epsoc %>% 
  mutate(rango_edad = rec(edad.seleccionado,
                          rec = "1:17 =  1[menor de 18 años];
                                 18:24 = 2[18 a 24 años]; 
                                 25:44 = 3[25 a 44 años];
                                 45:59 = 4[45 a 59 años]"))

frq(epsoc, rango_edad)
## 
## # rango_edad <numeric> 
## # total N=818  valid N=815  mean=3.24  sd=0.71
##  
##  val            label frq raw.prc valid.prc cum.prc
##    1 menor de 18 años   0    0.00      0.00    0.00
##    2     18 a 24 años 133   16.26     16.32   16.32
##    3     25 a 44 años 351   42.91     43.07   59.39
##    4     45 a 59 años 331   40.46     40.61  100.00
##   NA               NA   3    0.37        NA      NA
epsoc %>% 
  filter(is.na(rango_edad)) %>%
  select(sexo.seleccionado, edad.seleccionado, situacion.laboral.seleccionado)
## # A tibble: 3 x 3
##   sexo.seleccionado edad.seleccionado situacion.laboral.seleccionado
##   <dbl+lbl>                     <dbl> <dbl+lbl>                     
## 1 NA                               NA NA                            
## 2 NA                               NA NA                            
## 3 NA                               NA NA

Probablemente discrepancia de edad para las personas mayores de 59 años se debe a una confusión entre edad reportada o fecha de cumpleaños. Podría también tratarse de casos que tenían 59 años al momento de hacerse la encuesta, pero que al momento de validar los datos ya hayan cumplido los 60 .Quedarán asignados al grupo de edad rango_edad == 4.

epsoc <- epsoc %>% 
  mutate(rango_edad = replace(rango_edad, edad.seleccionado %in% c(60, 61), 4))

epsoc %>% 
  count(sexo.seleccionado, rango_edad, situacion.laboral.seleccionado) %>% 
  mutate_all(as_label) %>% 
  mutate(prop = round(n/sum(n), 4)) %>% 
  kable() %>% 
  kable_estilo()
sexo.seleccionado rango_edad situacion.laboral.seleccionado n prop
Hombre 18 a 24 años Trabaja 28 0.0342
Hombre 18 a 24 años No trabaja 36 0.0440
Hombre 25 a 44 años Trabaja 118 0.1443
Hombre 25 a 44 años No trabaja 12 0.0147
Hombre 45 a 59 años Trabaja 92 0.1125
Hombre 45 a 59 años No trabaja 20 0.0244
Mujer 18 a 24 años Trabaja 21 0.0257
Mujer 18 a 24 años No trabaja 48 0.0587
Mujer 25 a 44 años Trabaja 137 0.1675
Mujer 25 a 44 años No trabaja 84 0.1027
Mujer 45 a 59 años Trabaja 115 0.1406
Mujer 45 a 59 años No trabaja 104 0.1271
NA NA NA 3 0.0037

3.2 Duración entrevistas

La distribución de la duración de las entrevistas registrada por las tablets se puede ver en la siguiente figura.

homologar_fechas <- function(fecha){
  fecha %>% 
    str_replace_all(c("^\\D{3} " = "", '(.*)(\\d{4}$)' = '\\2 \\1')) %>% 
    anytime::anytime()
}

epsoc <- epsoc %>% 
  mutate_at(vars(starts_with('time')), homologar_fechas)
epsoc <- epsoc %>% 
  mutate(duration = str_replace_all(duration, c('-' = '', '^(\\d{2})' = '0\\.\\1'))) %>% 
  separate(duration, into = c('dura.d', 'duracion'), sep = '\\.', convert = TRUE, remove = FALSE) %>% 
  mutate(duracion.t = as.duration(hms(duracion) + hms(hms::hms(hour = (24 * dura.d)))))

epsoc$duracion.t.min <- epsoc$duracion.t@.Data/60

epsoc %>% 
  ggplot(aes(x = duracion.t.min)) + 
  geom_histogram(binwidth = 5) +
  theme_bw() +
  ggtitle("Distribución duración entrevistas por región (escala truncada < 150 minutos)") +
  labs(x = "Duración total entrevista (minutos)",
       y = "Frecuencia") +
  coord_cartesian(xlim = 0:150) +
  scale_x_continuous(breaks = seq(0, 150, by = 15)) +
  facet_grid(as_factor(region) ~ .)

Existen 40 entrevistas que duran menos de 20 minutos, estas debieran ser supervisadas.

epsoc %>%
  filter(as.double(duracion.t.min) < 20) %>%
  select(folio, duracion.t.min) %>% 
  knitr::kable(col.names = c("Folio", "Duración (minutos)"),
               caption = "Entrevistas de menos de 20 minutos",
               digits = 1) %>% 
  kable_estilo() %>% 
  column_spec(1, width = "10em") %>% 
  column_spec(2, width = "10em")
Entrevistas de menos de 20 minutos
Folio Duración (minutos)
200329 19.8
201186 18.2
201293 19.7
201350 11.4
201434 19.9
201863 16.0
201921 16.4
201947 19.1
202382 19.4
202465 19.6
202879 16.4
202895 19.3
203190 18.7
203372 18.4
204065 19.0
204396 19.5
204867 16.4
204966 18.6
205039 17.2
205443 19.4
205484 16.6
207431 16.9
207456 19.4
207464 14.2
208462 19.8
902296 17.6
902312 19.2
902940 17.9
903013 19.3
903088 20.0

Existen 43 entrevistas que duran más de 150 minutos, estas debieran ser supervisadas.

epsoc %>%
  filter(as.double(duracion.t.min) > 150) %>%
  transmute(folio, duracion.t.min / 60) %>% 
  knitr::kable(col.names = c("Folio", "Duración (horas)"),
               caption = "Entrevistas de más de 150 minutos",
               digits = 1) %>% 
  kable_estilo() %>% 
  column_spec(1, width = "10em") %>% 
  column_spec(2, width = "10em")
Entrevistas de más de 150 minutos
Folio Duración (horas)
200444 72.8
200527 69.8
200550 4.6
200717 49.6
202135 71.9
202671 25.7
203349 3.4
205427 14.2
900183 2.6
902569 2.7
903443 235.0
903815 236.7
903922 91.3
903963 120.9
905976 14.3
1301928 18.6
1301951 192.9
1302157 4.2
1302421 96.4
1303254 25.1
1303262 25.6
1303643 24.6
1303833 4.0
1304062 23.6
1304732 24.4
1305465 23.4
1305515 72.0
1306646 2.8
1307339 218.9
1307370 50.1
1310515 22.6
1311471 5.2
1312958 50.4

3.3 Producción por día

Cantidad de encuestas realizadas por día.

## Comienzo encuesta
epsoc$time1.hms <- hms::as.hms(epsoc$time1)
epsoc$time1.wday <- lubridate::wday(epsoc$time1)
epsoc$time1.dmy <- date(epsoc$time1)

epsoc %>% 
  count(time1.dmy) %>% 
  mutate(n_mean = mean(n)) %>%  
  ggplot(aes(x = time1.dmy, y = n)) +
  geom_line() +
  geom_smooth() +
  geom_hline(aes(yintercept = n_mean), colour = 'green') +
  geom_label(aes(x = min(time1.dmy)[[1]], y = n_mean[[1]], label = round(n_mean, 1))) +
  labs(title = 'Número de encuestas por día') +
  scale_x_date(breaks = '2 weeks')
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

epsoc %>% 
  count(time1.wday) %>% 
  mutate(n_mean = mean(n)) %>%  
  ggplot(aes(x = time1.wday, y = n)) +
  geom_line() +
  geom_smooth() +
  geom_hline(aes(yintercept = n_mean), colour = 'green') +
  geom_label(aes(x = min(time1.wday)[[1]], y = n_mean[[1]], label = round(n_mean, 1))) +
  labs(title = 'Número de encuestas por día de la semana') +
  scale_x_continuous(breaks = seq(7))
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

3.4 Georeferrenciación

Existen 186 entrevistas sin datos de georreferenciación:

epsoc %>% 
  select(folio, latitude, srvyr) %>% 
  group_by(srvyr) %>% 
  mutate(n.enc = length(folio)) %>% 
  filter(is.na(latitude)) %>%
  select(folio, srvyr, n.enc) %>% 
  mutate(n.enc.sg = (length(folio)/n.enc)*100) %>%       
  arrange(srvyr, folio) %>% 
  group_by_at(vars(-folio)) %>% 
  nest() %>% 
  mutate(Folio = map_chr(data, ~ flatten(.) %>% str_c(., collapse = ', '))) %>% 
  select(-data) %>% 
  kable(digits = 1, 
        col.names = c("Encuestador", "Total encuestas", "% sin georef.", "folios")) %>% 
  kable_estilo()
Encuestador Total encuestas % sin georef. folios
ageraldo.2 63 39.7 200857, 201376, 201475, 201715, 202143, 202465, 202598, 202770, 203034, 203042, 203083, 203216, 203224, 203240, 203315, 203331, 203570, 203877, 203885, 204040, 204081, 204289, 204297, 205237, 205427
atoledo.9 103 1.0 906164
cobando.9 26 23.1 903344, 903443, 903450, 903625, 903658, 906438
i.perez 23 30.4 1300433, 1301514, 1302850, 1312610, 1312636, 1312644, 1312669
j.morales 11 9.1 1305465
jossio.2 98 49.0 200253, 200493, 200691, 201038, 201053, 201186, 201293, 201392, 201491, 201590, 201749, 201863, 202192, 202226, 202242, 202267, 202382, 202481, 202796, 202879, 202895, 203059, 203067, 203075, 203141, 203190, 203489, 203588, 203752, 203760, 203794, 203844, 203851, 204396, 204644, 204867, 204966, 205039, 205062, 205484, 205658, 205682, 205872, 206144, 206177, 206763, 207233, 207266
ksakuda.2 29 48.3 201483, 201921, 202473, 202788, 203323, 203372, 203380, 204016, 207415, 207423, 207431, 207449, 207456, 207464
M.Alert 5 100.0 1305234, 1305242, 1306646, 1310515, 1311471
m.calderon 2 100.0 1310226, 1311935
mdiaz.2 83 7.2 202697, 203117, 203257, 203265, 203273, 205229
mrobles.2 58 51.7 200212, 200477, 201111, 201772, 202218, 202234, 202275, 202572, 204339, 204818, 204875, 205013, 205047, 205450, 205468, 205666, 205690, 205864, 205948, 205963, 206110, 206151, 206318, 206623, 206631, 206714, 207647, 207712, 207936, 208314
ncaceres.2 1 100.0 205930
nicol.alarcon 3 100.0 1310119, 1310143, 1310150
p.aguilera 4 75.0 1300912, 1300953, 1303726
p.gajardo 6 33.3 1303510, 1303528
p.vegazo 96 6.2 1300870, 1303825, 1304542, 1309129, 1309160, 1309178
rfigueroa.9 8 100.0 901918, 901926, 902023, 902056, 902072, 905919, 905943, 905950
s.gonzalez 16 75.0 1301910, 1301928, 1301936, 1301944, 1301951, 1301969, 1302066, 1303916, 1303940, 1303965, 1305911, 1307057
v.becerra 2 100.0 1300672, 1300698
v.sierra 55 3.6 1306679, 1306695
ycifuente.9 4 50.0 901314, 901322

3.5 Puntos de encuestas

epsoc_geo <- epsoc %>% 
  select(folio, sbj.num, region, srvyr, longitude, latitude) %>% 
  filter(!is.na(latitude)) %>% 
  sf::st_as_sf(coords = c('longitude', 'latitude'),
               crs = "+proj=longlat +ellps=GRS80")

sf::write_sf(epsoc_geo,
             here::here('validacion_epsoc_puntos_respuesta.kml'),
             dataset_options=c("NameField=folio"),
             delete_dsn=TRUE)

3.5.1 Antofagasta

epsoc_geo %>% 
  filter(region == 2) %>% 
  ggplot(aes(color = srvyr)) +
  geom_sf() 

3.5.2 Temuco

epsoc_geo %>% 
  filter(region == 9) %>% 
  ggplot(aes(color = srvyr)) +
  geom_sf()

3.5.3 Santiago

epsoc_geo %>% 
  filter(region == 13) %>% 
  ggplot(aes(color = srvyr)) +
  geom_sf()

4 Experimentos

EPSOC contiene dos experimentos que constituyen un foco de análisis del instrumento. El primer experimento consiste en un diseño factorial a través viñetas. El segundo se trata de una aleatorización del orden de preguntas sobre recompensa percibida y justa para tres objetos de evaluación: un obrero, un presidente de empresa y el respondente. Actualmente no es posible validar estos experimento por falta de información.

4.1 Viñetas

Para validar el proceso con las viñetas necesitamos:

  • Una breve explicación de cómo está codificado el experimento de las viñetas en la base de datos
  • La base de datos que asocia los folios con sets de viñeta en orden presentado
  • Acceso a grabaciones de voz durante el proceso de entrevista para asegurarnos que están bien asociadas las escalas con las variables

4.1.1 Distribución de viñetas

Revisar la distribución efectiva captada de los decks de viñetas en terreno hasta el momento.

epsoc %>% 
  select(folio, i.1.grupo) %>% 
  head()
## # A tibble: 6 x 2
##    folio i.1.grupo
##    <dbl> <chr>    
## 1 200139 23       
## 2 200147 17       
## 3 200162 11       
## 4 200212 15       
## 5 200220 15       
## 6 200238 31
epsoc %>% 
  transmute(i.1.grupo = as.integer(i.1.grupo),
            region) %>% 
  group_by_all() %>% 
  count() %>% 
  group_by(region) %>% 
  mutate(n_mean = mean(n)) %>% 
  ggplot(aes(x = as_factor(i.1.grupo), y = n)) +
  geom_col() +
  geom_hline(aes(group = region, yintercept = n_mean), colour = 'green') + 
  geom_text(aes(label = ..y..), nudge_y = 1, size = 3) +
  facet_grid(rows = vars(region)) +
  labs(title = 'Distribución de viñetas')

4.1.2 Duración ejercicio

  • Los marcadores de tiempo time2 y time3 no siguen un formato homogéneo para registrar la hora. Por ejemplo, en algún caso se utiliza el formato “2018-10-27T19:05:08-03:00” y en otros “Fri Oct 19 13:01:59 -0300 2018”
  • Homogeneizar formatos de tiempos y fechas a ISO8601
## Comienzo viñetas
epsoc$time2.hms <- hms::as.hms(epsoc$time2)
epsoc$time2.dmy <- date(epsoc$time2)

## Fin viñetas
epsoc$time3.hms <- hms::as.hms(epsoc$time3)
epsoc$time3.dmy <- date(epsoc$time3)

epsoc$dura.vinetas <- difftime(epsoc$time3, epsoc$time2,
                               units = "mins")

ggplot(epsoc, aes(x = time2.dmy, y = time2.hms)) + 
  geom_point(alpha = 0.6) +
  labs(x = "Día", y = "Hora") + 
  ggtitle("Día y hora comienzo actividad viñetas") + 
  theme_bw()

ggplot(epsoc, aes(x = srvyr, y = time2.hms)) + 
  geom_point(alpha = 0.6) +
  labs(x = "Encuestador", y = "Hora") + 
  ggtitle("Hora comienzo actividad viñetas según encuestador") + 
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1))

epsoc %>% 
  mutate(vin.cort = ifelse(dura.vinetas < 5, "< 5'", ">= 5'")) %>% 
  ggplot(aes(dura.vinetas)) + 
  geom_histogram(aes(fill = vin.cort)) + theme_bw() +
  theme(legend.title=element_blank()) +
  ggtitle("Duración ejercicio viñetas") +
  xlab("Minutos")

Como se puede ver en la figura anterior, la distribución del tiempo de duración del ejercicio de viñetas es variable. En términos de validación, llama la atención que se logre realizar el ejercicio en menos de cinco minutos. Estos casos deberían ser revisados apenas sea posible.

ggplot(epsoc, aes(x = srvyr, y = if_else(dura.vinetas < 60, dura.vinetas, 60), 
                  colour = status)) + 
  geom_point(alpha = 0.5,
             position = position_jitter(width = .2)) +
  scale_color_manual(values = c('green', 'orange', 'blue')) + 
  facet_grid(cols = vars(region), scales = 'free_x', space = 'free_x') +
  labs(x = "Encuestador", y = "minutos") + 
  ggtitle("Duración de actividad viñetas según encuestador según región") + 
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1))
## Don't know how to automatically pick scale for object of type difftime. Defaulting to continuous.

En particular, deben supervisarse las siguientes entrevistas donde el ejercicio duró menos de 5 minutos:

kable(epsoc %>% 
        group_by(srvyr) %>% 
        mutate(n.enc = length(folio)) %>% 
        select(folio, dura.vinetas, srvyr, n.enc) %>% 
        filter(dura.vinetas <= 5) %>%
        mutate(n.enc.cort = (length(folio)/n.enc)*100) %>% 
        arrange(srvyr, dura.vinetas), 
      digits = 1,
      col.names = c("Folio", "Duración viñetas", "Encuestador", "Total encuestas", "% cortas"),
      caption = "Ejercicio viñetas de menos de 5 minutos") %>% 
  kable_estilo() #%>% 
Ejercicio viñetas de menos de 5 minutos
Folio Duración viñetas Encuestador Total encuestas % cortas
205427 2.6 mins ageraldo.2 63 3.2
202465 5.0 mins ageraldo.2 63 3.2
902296 4.4 mins atoledo.9 103 1.0
902254 4.1 mins cobando.9 26 3.8
204966 4.3 mins jossio.2 98 3.1
204396 4.6 mins jossio.2 98 3.1
201186 4.7 mins jossio.2 98 3.1
1310119 3.2 mins nicol.alarcon 3 33.3
905943 4.9 mins rfigueroa.9 8 12.5
#column_spec(1, width = "10em") %>% 
#column_spec(2, width = "10em") %>% 
#column_spec(3, width = "10em")

4.1.3 Reconstrucción de variables de outcome

labels_correcion <- function(.vect) {
  replace(.vect, .vect == 6, -1) %>% 
    remove_labels(labels = '- 1') %>% 
    add_labels(labels = c('- 1' = -1))
}

gg_ideologia_orden <- function(.data, var_orden, miss = 88){
  var_orden_quo <- enquo(var_orden)
  
  .data %>% 
    gather('variable', 'valor', -!!var_orden_quo) %>% 
    filter(valor < miss) %>%
    ggplot(aes(x = valor)) +
    geom_bar() +
    facet_grid(rows = vars(variable),
               cols = vars(!!var_orden_quo))
}

4.1.3.1 Ideología para ego y alter

ideologia_ego <- list(orden1 = c("c0.1", "c1.1.1", "c1.2.1", "c1.3.1", "c1.4.1", "c2.1.1", "c2.2.1", "c2.3.1", "c2.4.1"),
                      orden2 = c("c0.2", "c1.4.2", "c1.1.2", "c1.2.2", "c1.3.2", "c2.4.2", "c2.1.2", "c2.2.2", "c2.3.2"),
                      orden3 = c("c0.3", "c1.3.3", "c1.4.3", "c1.1.3", "c1.2.3", "c2.3.3", "c2.4.3", "c2.1.3", "c2.2.3"), 
                      orden4 = c("c0.4", "c1.2.4", "c1.3.4", "c1.4.4", "c1.1.4", "c2.2.4", "c2.3.4", "c2.4.4", "c2.1.4"))

df_ideologia_ego <- epsoc %>% 
  select(folio, i.1.orden, !!!flatten_chr(ideologia_ego)) %>% 
  nest(-i.1.orden) %>% 
  arrange(i.1.orden)

df_ideologia_ego <- df_ideologia_ego %>% 
  mutate(orden = ideologia_ego[str_glue("orden{i.1.orden + 1}")],
         data = map2(data, orden, ~select(.x, one_of("folio", .y))),
         data_var = map(data, names) %>% map_chr(str_c, collapse = ', '))

df_ideologia_ego
## # A tibble: 4 x 4
##   i.1.orden data          orden   data_var                                 
##       <int> <list>        <list>  <chr>                                    
## 1         0 <tibble [191… <chr [… folio, c0.1, c1.1.1, c1.2.1, c1.3.1, c1.…
## 2         1 <tibble [206… <chr [… folio, c0.2, c1.4.2, c1.1.2, c1.2.2, c1.…
## 3         2 <tibble [208… <chr [… folio, c0.3, c1.3.3, c1.4.3, c1.1.3, c1.…
## 4         3 <tibble [213… <chr [… folio, c0.4, c1.2.4, c1.3.4, c1.4.4, c1.…
map_dfc(df_ideologia_ego$data, get_label) %>% 
  mutate_all(str_trunc, width = 25)
## # A tibble: 10 x 4
##    V1                 V2                V3                V4               
##    <chr>              <chr>             <chr>             <chr>            
##  1 ""                 ""                ""                ""               
##  2 Observe esta esca… Observe esta esc… Observe esta esc… Observe esta esc…
##  3 "Escala \"Las fam… "Escala \"Las fa… "Escala \"Las fa… "Escala \"Las fa…
##  4 "Escala \"Chile n… "Escala \"Chile … "Escala \"Chile … "Escala \"Chile …
##  5 "Escala \"Educaci… "Escala \"Educac… "Escala \"Educac… "Escala \"Educac…
##  6 "Escala \"Más con… "Escala \"Más co… "Escala \"Más co… "Escala \"Más co…
##  7 "Escala \"Las fam… "Escala \"Las fa… "Escala \"Las fa… "Escala \"Las fa…
##  8 "Escala \"Chile n… "Escala \"Chile … "Escala \"Chile … "Escala \"Chile …
##  9 "Escala \"Educaci… "Escala \"Educac… "Escala \"Educac… "Escala \"Educac…
## 10 "Escala \"Más con… "Escala \"Más co… "Escala \"Más co… "Escala \"Más co…
suppressWarnings(
  df_ideologia_ego <- df_ideologia_ego %>% 
    mutate(data = map(data, ~rename_all(.x, ~c("folio", str_remove(ideologia_ego$orden1,'.\\d{1,2}$'))))) %>% 
    select(data) %>% 
    unnest()
)

df_ideologia_ego <- copy_labels(df_new = df_ideologia_ego,
                                df_origin = epsoc %>% 
                                  select(one_of(c('folio', ideologia_ego$orden1))) %>% 
                                  rename_all(~c("folio", str_remove(ideologia_ego$orden1,'.\\d{1,2}$'))))

Agregar variables reconstruidas a base de datos.

epsoc <- left_join(epsoc, 
                   df_ideologia_ego,
                   by = 'folio')
## Warning: Column `folio` has different attributes on LHS and RHS of join
epsoc %>% 
  select(i.1.orden, matches("c[1-2].\\d{1}$")) %>% 
  gather('variable', 'valor', -i.1.orden) %>% 
  mutate(referencia = if_else(str_detect(variable, 'c1.*'), 'ego', 'alter'),
         outcome = str_extract(variable, '(\\d*)$')) %>% 
  filter(valor < 88) %>% 
  ggplot(aes(x = valor, fill = fct_rev(referencia))) +
  geom_bar(position = position_dodge()) +
  facet_grid(rows = vars(outcome),
             cols = vars(i.1.orden)) +
  labs(title = 'Distribución de viñetas ego y alter, según orden de preguntas') +
  scale_fill_discrete(name = 'Referencia')
## Warning: attributes are not identical across measure variables;
## they will be dropped

4.1.3.2 Ideología para viñetas

Primero es necesario reunir las variables

ideologia_vin <- list(orden1 = c(1, 2, 3, 4),
                      orden2 = c(4, 1, 2, 3),
                      orden3 = c(3, 4, 1, 2), 
                      orden4 = c(2, 3, 4, 1))

df_ideologia_vin <- epsoc %>% 
  select(folio, i.1.orden, matches("^c([3-9]|10)\\.[1-4].*")) %>% 
  nest(-i.1.orden) %>% 
  arrange(i.1.orden)

ideologia_variables <- function(persona, orden, grupo){
  expand.grid(persona, orden, grupo) %>% 
  arrange(Var1) %>% 
  str_glue_data("c{Var1}.{Var2}.{Var3}")
}

df_ideologia_vin <- df_ideologia_vin %>% 
  mutate(orden = ideologia_vin[str_glue("orden{i.1.orden + 1}")],
         variables = map2(orden, i.1.orden + 1, ~ideologia_variables(3:10, .x, .y)),
         data = map2(data, variables, ~select(.x, one_of("folio", .y))),
         data_var = map(data, names) %>% map_chr(str_c, collapse = ', '))

df_ideologia_vin %>% 
  select(i.1.orden, data_var)
## # A tibble: 4 x 2
##   i.1.orden data_var                                                       
##       <int> <chr>                                                          
## 1         0 folio, c3.1.1, c3.2.1, c3.3.1, c3.4.1, c4.1.1, c4.2.1, c4.3.1,…
## 2         1 folio, c3.4.2, c3.1.2, c3.2.2, c3.3.2, c4.4.2, c4.1.2, c4.2.2,…
## 3         2 folio, c3.3.3, c3.4.3, c3.1.3, c3.2.3, c4.3.3, c4.4.3, c4.1.3,…
## 4         3 folio, c3.2.4, c3.3.4, c3.4.4, c3.1.4, c4.2.4, c4.3.4, c4.4.4,…
etiquetas <- map(df_ideologia_vin$data, get_labels)
ideologia_vin1_names <- names(df_ideologia_vin$data[[1]])
ideologia_vin1_gen_names <- str_remove(ideologia_vin1_names, '.\\d{1,2}$')

suppressWarnings(
  df_ideologia_vin <- df_ideologia_vin %>% 
    mutate(data = map(data, ~rename_all(.x, ~ideologia_vin1_gen_names))) %>% 
    select(data) %>% 
    unnest()
)

df_ideologia_vin <- copy_labels(df_new = df_ideologia_vin,
                                df_origin = epsoc %>% 
                                  select(!!!ideologia_vin1_names) %>% 
                                  rename_all(~ideologia_vin1_gen_names))

head(df_ideologia_vin)
## # A tibble: 6 x 33
##    folio  c3.1  c3.2  c3.3  c3.4  c4.1  c4.2  c4.3  c4.4  c5.1  c5.2  c5.3
##    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 200162     1     1    11     1     1     1    11     1    11     1     1
## 2 200238    11    10     1     2     2     1    11    11     3     3    10
## 3 200246    11     1    11     1     1    11    11    11    11     1     1
## 4 200329     4    11    10     3     4     9     3     3     8     3    10
## 5 200337     2     2     1     1     6    10     1     1     1     9     3
## 6 200410     1     1     1     1    11    11     1     1    11    11     1
## # … with 21 more variables: c5.4 <dbl>, c6.1 <dbl>, c6.2 <dbl>,
## #   c6.3 <dbl>, c6.4 <dbl>, c7.1 <dbl>, c7.2 <dbl>, c7.3 <dbl>,
## #   c7.4 <dbl>, c8.1 <dbl>, c8.2 <dbl>, c8.3 <dbl>, c8.4 <dbl>,
## #   c9.1 <dbl>, c9.2 <dbl>, c9.3 <dbl>, c9.4 <dbl>, c10.1 <dbl>,
## #   c10.2 <dbl>, c10.3 <dbl>, c10.4 <dbl>

Agregar variables reconstruidas a base de datos.

epsoc <- left_join(epsoc, 
                   df_ideologia_vin,
                   by = 'folio')
## Warning: Column `folio` has different attributes on LHS and RHS of join

Gráficos para comparar distribuciones entre viñetas y orden

epsoc %>% 
  select(i.1.orden, matches('c([3-9]|10).1$')) %>% 
  gg_ideologia_orden(i.1.orden) +
  labs(title = 'Distribución de viñetas Familias, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped

epsoc %>% 
  select(i.1.orden, matches('c([3-9]|10).2$')) %>% 
  gg_ideologia_orden(i.1.orden) +
  labs(title = 'Distribución de viñetas Orden o Cambio, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped

epsoc %>% 
  select(i.1.orden, matches('c([3-9]|10).3$')) %>% 
  gg_ideologia_orden(i.1.orden) +
  labs(title = 'Distribución de viñetas Educación, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped

epsoc %>% 
  select(i.1.orden, matches('c([3-9]|10).4$')) %>% 
  gg_ideologia_orden(i.1.orden) +
  labs(title = 'Distribución de viñetas Grandes Empresas, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped

4.2 Recompensa justa

Para validar el experimento de evaluación de justicia necesitamos: - Una breve explicación de cómo están codificados los items de recompensa percibida y recompensa justa para un obrero, el presidente de una empresa y el respondente - Es fundamental saber cuál es la variable que define el orden en que se presentó una y otra pregunta

4.2.1 Distribución de tratamientos

La variable a que determina el tratamiento mostrado en la encuesta es la variable num.grupo.jd.

flat_table(epsoc, num.grupo.jd, region, margin = 'col')
##              region     2     9    13
## num.grupo.jd                         
## 0                   26.80 23.31 22.73
## 1                   23.63 27.61 25.32
## 2                   27.95 21.47 26.62
## 3                   21.61 27.61 25.32

4.2.2 Variables asociadas

Existen 24 variables asociadas al experimiento de recompensa justa que se detallan a continuación:

var_rec_justa <- find_var(epsoc, pattern = stringr::regex('obrero|pdte'), search = 'label')

var_rec_justa$var.label %>% 
  str_replace_all(c('Quisiéramos saber cuánto dinero cree Ud. que ganan las personas al mes en estos trabajos u ocupaciones que se mencionan más adelante, después de considerar los descuentos de salud, previsión u otros impuestos' = 'cuánto dinero cree Ud. que ganan',
                    'Pensando en lo que Ud. cree que las personas en estos trabajos deberían ganar al mes, después de los descuentos de salud, previsión u otros impuestos. ' = '')) %>% 
   paste0(var_rec_justa$var.name, " - ", sort(rep(seq(6), 4)), " - ", .)
##  [1] "i.1.g1a.1.rec - 1 - cuánto dinero cree Ud. que ganan (pdte empresa)"                                                                                                                                                                                                         
##  [2] "i.2.g1a.1.rec - 1 - cuánto dinero cree Ud. que ganan (obrero)"                                                                                                                                                                                                               
##  [3] "i.1.g2a.1.rec - 1 - ¿Cuál sería una remuneración justa para (pdte empresa)?"                                                                                                                                                                                                 
##  [4] "i.2.g2a.1.rec - 1 - ¿Cuál sería una remuneración justa para (obrero)?"                                                                                                                                                                                                       
##  [5] "i.1.g2a.2.rec - 2 - ¿Cuál sería una remuneración justa para (pdte empresa)?"                                                                                                                                                                                                 
##  [6] "i.2.g2a.2.rec - 2 - ¿Cuál sería una remuneración justa para (obrero)?"                                                                                                                                                                                                       
##  [7] "i.1.g1a.2.rec - 2 - cuánto dinero cree Ud. que ganan (pdte empresa)"                                                                                                                                                                                                         
##  [8] "i.2.g1a.2.rec - 2 - cuánto dinero cree Ud. que ganan (obrero)"                                                                                                                                                                                                               
##  [9] "i.1.g1a.3.rec - 3 - cuánto dinero cree Ud. que ganan (pdte empresa)"                                                                                                                                                                                                         
## [10] "i.2.g1a.3.rec - 3 - cuánto dinero cree Ud. que ganan (obrero)"                                                                                                                                                                                                               
## [11] "i.1.g2b.3.rec - 3 - ¿Cuál sería una remuneración justa para (pdte empresa)?"                                                                                                                                                                                                 
## [12] "i.2.g2b.3.rec - 3 - ¿Cuál sería una remuneración justa para (obrero)?"                                                                                                                                                                                                       
## [13] "i.1.g1b.4.rec - 4 - ¿Cuál sería una remuneración justa para (pdte empresa)?"                                                                                                                                                                                                 
## [14] "i.2.g1b.4.rec - 4 - ¿Cuál sería una remuneración justa para (obrero)?"                                                                                                                                                                                                       
## [15] "i.1.g1a.4.rec - 4 - cuánto dinero cree Ud. que ganan (pdte empresa)"                                                                                                                                                                                                         
## [16] "i.2.g1a.4.rec - 4 - cuánto dinero cree Ud. que ganan (obrero)"                                                                                                                                                                                                               
## [17] "i.1.g1a.3.2 - 5 - (un obrero no calificado de una fábrica) Quisiéramos saber cuánto dinero cree Ud. que ganan las personas al mes en estos trabajos/ocupaciones que se mencionan más adelante, después de considerar los descuentos de salud, previsión u otros impuestos (i"
## [18] "i.1.g1b.3.2 - 5 - (un obrero no calificado de una fábrica) Pensando en lo que Ud. cree que sería justo que las personas en estos trabajos deberían ganar al mes, después de los descuentos de salud, previsión u otros impuestos (ingreso líquido).  ¿Cuál sería una remu"   
## [19] "i.1.g2b.4.2 - 5 - (un obrero no calificado de una fábrica) Pensando en lo que Ud. cree que sería justo que las personas en estos trabajos deberían ganar al mes, después de los descuentos de salud, previsión u otros impuestos (ingreso líquido).  ¿Cuál sería una remu"   
## [20] "i.1.g2a.4.2 - 5 - (un obrero no calificado de una fábrica) Quisiéramos saber cuánto dinero cree Ud. que ganan las personas al mes en estos trabajos/ocupaciones que se mencionan más adelante, después de considerar los descuentos de salud, previsión u otros impuestos (i"
## [21] "i.1.g1a.1.rec - 6 - cuánto dinero cree Ud. que ganan (pdte empresa)"                                                                                                                                                                                                         
## [22] "i.2.g1a.1.rec - 6 - cuánto dinero cree Ud. que ganan (obrero)"                                                                                                                                                                                                               
## [23] "i.1.g2a.1.rec - 6 - ¿Cuál sería una remuneración justa para (pdte empresa)?"                                                                                                                                                                                                 
## [24] "i.2.g2a.1.rec - 6 - ¿Cuál sería una remuneración justa para (obrero)?"

Al inicio de la aplicación del cuestionario se implementó 4 grupos (del grupo 1 al 4 o variables i.1.g1a.1.rec a i.2.g1a.4.rec). Como puede verse el grupo 3 es identico al 1 y el grupo 4 es igual al 2 porque se mantuvo el orden de presidente empresa y luego obrero.

Para solucionarlo, se agregaron los grupos 5 y 6 en donde se se cambia el orden a obrero y luego presidente empresa. Con esto los 4 grupos (1, 2, 5 y 6) a los que cada persona se verá confrontada serán diferentes. Como se puede ver en el gráfico , la implementación del cambio se efectuó correctamente.

epsoc %>% 
  arrange(num.grupo.jd, time1) %>% 
  select(one_of(var_rec_justa$var.name)) %>% 
  naniar::vis_miss() +
  labs(title = 'Distribución de respuestas en preguntas de recompensa justa') +
  theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 0))

4.3 Items justicia

La encuesta considera una serie de preguntas con escalas predefinidas. A continuación se revisa que los ítems sobre justicia tengan respuestas en el rango de 1 a 5 o bien valores de 8 o 9.

item_just <- find_var(epsoc, "usto")
item_just$var.name
##  [1] "i.6.a1"      "i.8.a1"      "i.9.a1"      "i.10.a1"     "i.11.a1"    
##  [6] "i.12.a1"     "i.13.a1"     "i.16.a1"     "i.1.g1b.3.2" "i.2.g1b.3.2"
## [11] "i.1.g2b.4.2" "i.2.g2b.4.2" "i.1.h1"      "i.2.h1"      "i.5.h1"     
## [16] "i.7.h1"      "i.8.h1"      "i.10.h1"     "i.11.h1"     "i.12.h1"    
## [21] "i.14.h1"
v <- validator(j := var_group(i.6.a1, i.8.a1, i.9.a1, i.10.a1, i.11.a1, i.12.a1, i.13.a1, i.16.a1, 
                              i.1.h1, i.2.h1, i.5.h1, i.7.h1, i.8.h1, i.10.h1, i.11.h1, i.12.h1, i.14.h1), 
               j >= 1,
               j <= 9,
               j != 6,
               j != 7)

cf2 <- confront(epsoc, v)
s.cf2 <- summary(cf2)

knitr::kable(s.cf2) %>% 
  kable_estilo()
name items passes fails nNA error warning expression
V2.1 818 818 0 0 FALSE FALSE (i.6.a1 - 1) >= -1e-08
V2.2 818 818 0 0 FALSE FALSE (i.8.a1 - 1) >= -1e-08
V2.3 818 818 0 0 FALSE FALSE (i.9.a1 - 1) >= -1e-08
V2.4 818 818 0 0 FALSE FALSE (i.10.a1 - 1) >= -1e-08
V2.5 818 818 0 0 FALSE FALSE (i.11.a1 - 1) >= -1e-08
V2.6 818 818 0 0 FALSE FALSE (i.12.a1 - 1) >= -1e-08
V2.7 818 818 0 0 FALSE FALSE (i.13.a1 - 1) >= -1e-08
V2.8 818 818 0 0 FALSE FALSE (i.16.a1 - 1) >= -1e-08
V2.9 818 818 0 0 FALSE FALSE (i.1.h1 - 1) >= -1e-08
V2.10 818 818 0 0 FALSE FALSE (i.2.h1 - 1) >= -1e-08
V2.11 818 818 0 0 FALSE FALSE (i.5.h1 - 1) >= -1e-08
V2.12 818 818 0 0 FALSE FALSE (i.7.h1 - 1) >= -1e-08
V2.13 818 818 0 0 FALSE FALSE (i.8.h1 - 1) >= -1e-08
V2.14 818 818 0 0 FALSE FALSE (i.10.h1 - 1) >= -1e-08
V2.15 818 818 0 0 FALSE FALSE (i.11.h1 - 1) >= -1e-08
V2.16 818 818 0 0 FALSE FALSE (i.12.h1 - 1) >= -1e-08
V2.17 818 818 0 0 FALSE FALSE (i.14.h1 - 1) >= -1e-08
V3.1 818 818 0 0 FALSE FALSE (i.6.a1 - 9) <= 1e-08
V3.2 818 818 0 0 FALSE FALSE (i.8.a1 - 9) <= 1e-08
V3.3 818 818 0 0 FALSE FALSE (i.9.a1 - 9) <= 1e-08
V3.4 818 818 0 0 FALSE FALSE (i.10.a1 - 9) <= 1e-08
V3.5 818 818 0 0 FALSE FALSE (i.11.a1 - 9) <= 1e-08
V3.6 818 818 0 0 FALSE FALSE (i.12.a1 - 9) <= 1e-08
V3.7 818 818 0 0 FALSE FALSE (i.13.a1 - 9) <= 1e-08
V3.8 818 818 0 0 FALSE FALSE (i.16.a1 - 9) <= 1e-08
V3.9 818 818 0 0 FALSE FALSE (i.1.h1 - 9) <= 1e-08
V3.10 818 818 0 0 FALSE FALSE (i.2.h1 - 9) <= 1e-08
V3.11 818 818 0 0 FALSE FALSE (i.5.h1 - 9) <= 1e-08
V3.12 818 818 0 0 FALSE FALSE (i.7.h1 - 9) <= 1e-08
V3.13 818 818 0 0 FALSE FALSE (i.8.h1 - 9) <= 1e-08
V3.14 818 818 0 0 FALSE FALSE (i.10.h1 - 9) <= 1e-08
V3.15 818 818 0 0 FALSE FALSE (i.11.h1 - 9) <= 1e-08
V3.16 818 818 0 0 FALSE FALSE (i.12.h1 - 9) <= 1e-08
V3.17 818 818 0 0 FALSE FALSE (i.14.h1 - 9) <= 1e-08
V4.1 818 818 0 0 FALSE FALSE i.6.a1 != 6
V4.2 818 818 0 0 FALSE FALSE i.8.a1 != 6
V4.3 818 818 0 0 FALSE FALSE i.9.a1 != 6
V4.4 818 818 0 0 FALSE FALSE i.10.a1 != 6
V4.5 818 818 0 0 FALSE FALSE i.11.a1 != 6
V4.6 818 818 0 0 FALSE FALSE i.12.a1 != 6
V4.7 818 818 0 0 FALSE FALSE i.13.a1 != 6
V4.8 818 818 0 0 FALSE FALSE i.16.a1 != 6
V4.9 818 818 0 0 FALSE FALSE i.1.h1 != 6
V4.10 818 818 0 0 FALSE FALSE i.2.h1 != 6
V4.11 818 818 0 0 FALSE FALSE i.5.h1 != 6
V4.12 818 818 0 0 FALSE FALSE i.7.h1 != 6
V4.13 818 818 0 0 FALSE FALSE i.8.h1 != 6
V4.14 818 818 0 0 FALSE FALSE i.10.h1 != 6
V4.15 818 818 0 0 FALSE FALSE i.11.h1 != 6
V4.16 818 818 0 0 FALSE FALSE i.12.h1 != 6
V4.17 818 818 0 0 FALSE FALSE i.14.h1 != 6
V5.1 818 818 0 0 FALSE FALSE i.6.a1 != 7
V5.2 818 818 0 0 FALSE FALSE i.8.a1 != 7
V5.3 818 818 0 0 FALSE FALSE i.9.a1 != 7
V5.4 818 818 0 0 FALSE FALSE i.10.a1 != 7
V5.5 818 818 0 0 FALSE FALSE i.11.a1 != 7
V5.6 818 818 0 0 FALSE FALSE i.12.a1 != 7
V5.7 818 818 0 0 FALSE FALSE i.13.a1 != 7
V5.8 818 818 0 0 FALSE FALSE i.16.a1 != 7
V5.9 818 818 0 0 FALSE FALSE i.1.h1 != 7
V5.10 818 818 0 0 FALSE FALSE i.2.h1 != 7
V5.11 818 818 0 0 FALSE FALSE i.5.h1 != 7
V5.12 818 818 0 0 FALSE FALSE i.7.h1 != 7
V5.13 818 818 0 0 FALSE FALSE i.8.h1 != 7
V5.14 818 818 0 0 FALSE FALSE i.10.h1 != 7
V5.15 818 818 0 0 FALSE FALSE i.11.h1 != 7
V5.16 818 818 0 0 FALSE FALSE i.12.h1 != 7
V5.17 818 818 0 0 FALSE FALSE i.14.h1 != 7

Existen 0 variables de actitudes sobre justicia fuera de rango.

5 Otros criterios generales

Para validar los datos consideramos los siguientes criterios:

  • El rango etario de la población (18 a 59 años)
  • Una duración de menos de dos horas
  • Una duración de más de quince minutos
  • Las variables con información redundante deben converger (edad y sexo)
  • Número de hijos
epsoc$duration <- chron(times=epsoc$duration)
## Warning in convert.times(times., fmt): NAs introduced by coercion
## Warning in convert.times(times., fmt): time-of-day entries out of range in
## positions NA,NA,NA,NA,NA,NA,NA,NA,NA,NA set to NA
cf <- check_that(epsoc, edad.seleccionado <= 59 & edad.seleccionado >= 18,
                 sexo.enc == sexo.seleccionado)
s.cf <- summary(cf)
knitr::kable(s.cf) %>% 
        kable_estilo()
name items passes fails nNA error warning expression
V1 818 815 0 3 FALSE FALSE edad.seleccionado <= 59 & edad.seleccionado >= 18
V2 818 804 11 3 FALSE FALSE abs(sexo.enc - sexo.seleccionado) < 1e-08

Resultados:

  • No existen respondentes fuera del rango etario.
  • Existen 11 divergencias respecto al sexo del encuestado al comparar la variable sexo.enc y sexo.seleccionado.

5.1 Edad

## Fecha de nacimiento y edad seleccionado
epsoc$enc.edad[as.character(epsoc$enc.edad) == "1582-10-14"] <- NA # comportamiento extraño al importar desde SPSS
edad <- tibble(Folio = epsoc$folio[is.na(epsoc$enc.edad)],
               Fecha = epsoc$enc.edad[is.na(epsoc$enc.edad)],
               Edad = epsoc$edad.seleccionado[is.na(epsoc$enc.edad)]) 
knitr::kable(edad,
             caption = "Casos sin fecha de nacimiento en `enc_edad`",
             col.names = c("Folio", "Fecha nacimiento", "Edad")) %>% 
  kable_estilo()
Casos sin fecha de nacimiento en enc_edad
Folio Fecha nacimiento Edad
201350 NA 56
201467 NA 59
202457 NA 18
202580 NA 59
203182 NA 39
203273 NA 59
203315 NA 52
205237 NA 59
900134 NA 59
900753 NA 53
900779 NA 59
901918 NA 25
902320 NA 59
902338 NA 56
902361 NA 59
902379 NA 59
902510 NA 59
902924 NA 59
905422 NA 59
905448 NA 59
905471 NA 51
905877 NA 20
905976 NA 59
1302538 NA 47
1303577 NA 39
1309913 NA 49
1310119 NA 39
1310143 NA 26
1310150 NA 55
1311935 NA 24
1312438 NA 48

5.2 Sexo

epsoc %>% 
  filter(sexo.enc != sexo.seleccionado) %>% 
  select(Folio = folio, sexo.enc, sexo.seleccionado) %>% 
  knitr::kable(col.names = c("Folio", "sexo.enc", "sexo.seleccionado"),
               caption = "Entrevistas donde sexo encuestado y seleccionado no coinciden") %>% 
  kable_estilo()
Entrevistas donde sexo encuestado y seleccionado no coinciden
Folio sexo.enc sexo.seleccionado
200444 1 2
201483 1 2
205237 2 1
902213 1 2
1301928 2 1
1301936 2 1
1301944 2 1
1301969 1 2
1305911 2 1
1307131 2 1
1309913 1 2

5.3 Número de hijos

frq(epsoc$f22)
## 
## # ¿Tiene usted hijos o hijas? ¿Cuántos/as? (x) <numeric> 
## # total N=818  valid N=818  mean=2.69  sd=1.49
##  
##  val                 label frq raw.prc valid.prc cum.prc
##    1           No, ninguno 221   27.02     27.02   27.02
##    2                 Uno/a 174   21.27     21.27   48.29
##    3                   Dos 198   24.21     24.21   72.49
##    4                  Tres 140   17.11     17.11   89.61
##    5                Cuatro  54    6.60      6.60   96.21
##    6                 Cinco  12    1.47      1.47   97.68
##    7            Seis o más  16    1.96      1.96   99.63
##    8     No sabe [No leer]   0    0.00      0.00   99.63
##    9 No responde [No leer]   3    0.37      0.37  100.00
##   NA                    NA   0    0.00        NA      NA
hijos <- epsoc %>%
  select(folio, f22:f26.o5) %>%
  mutate(hijo_n       = ifelse(f22 <= 7, f22 - 1, NA),
         hijo_estudia = ifelse(f23 <= 7, f23 - 1, NA),
         hijo_egreso  = ifelse(f25 <= 7, f25 - 1, NA),
         hijo_suma    = hijo_estudia + hijo_egreso) %>%
  filter(hijo_n < hijo_suma)

hijos %>% 
  select(folio, starts_with('hijo')) %>% 
  arrange(desc(abs(hijo_n - hijo_suma)))
## # A tibble: 16 x 5
##      folio hijo_n hijo_estudia hijo_egreso hijo_suma
##      <dbl>  <dbl>        <dbl>       <dbl>     <dbl>
##  1  200212      4            4           4         8
##  2  207449      4            4           4         8
##  3  203091      6            4           5         9
##  4  203380      2            2           2         4
##  5 1307057      3            3           2         5
##  6  200139      6            4           3         7
##  7  201541      1            1           1         2
##  8  201665      3            2           2         4
##  9  201715      1            2           0         2
## 10  202465      6            1           6         7
## 11  202572      3            4           0         4
## 12  207456      6            5           2         7
## 13  902221      1            1           1         2
## 14 1301753      2            2           1         3
## 15 1302066      3            3           1         4
## 16 1304765      2            2           1         3

6 Grabaciones

Grabar base de datos con variables de viñetas reconstruidas.

epsoc %>% 
  mutate_if(is.numeric, as_labelled) %>% 
  haven::write_sav("../EPSOC Base parcial con vinetas.sav")

Obtención de archivos de grabaciones de cada encuesta.

 path_general <- '../SurveyToGo Attachments/EPSOC 2018/'

 archivos <- dir(path = path_general, 
     pattern = str_c(epsoc$sbj.num, collapse = '|'),
     recursive = TRUE)
 
 file.copy(from = str_c(path_general, archivos), 
           to = "grabaciones/",
           overwrite = TRUE)